⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umainform2.pas

📁 Delphi函数工厂。。。。。。。。。。。。。
💻 PAS
📖 第 1 页 / 共 2 页
字号:
begin
  if FPlaySound then
    PlaySound('SCLICK', hInstance, SND_ASYNC or SND_RESOURCE
      or SND_NODEFAULT);
end;

procedure TfmMain.OnUserButtonClick(Sender: TObject);
var
  aIndex: Integer;
begin
  PlayButtonBarButtonClickSound;
  with TbsButtonBarItem(Sender) do
  begin
    aIndex := FUserButtonsList.IndexOf(Text);
    if aIndex <> -1 then
      with TButtonInfo(FUserButtonsList.Objects[aIndex]) do
      begin
        ShellExecute(0, 'OPEN', PChar(FileName),
          PChar(Params), PChar(ExtractFilePath(FileName)), SW_SHOWNORMAL);
      end;
  end;
end;

function TfmMain.AddToolButton(const AButtonName, AFile, AParams: string;
  const ASection: integer): Boolean;
var
  MaxCount: Integer;
  ButtonInfo: TButtonInfo;
begin
  Result := False;
  with FUserButtonsIniFile do
  begin
    if SectionExists(AButtonName) then Exit;
    WriteString(AButtonName, 'File', AFile);
    WriteString(AButtonName, 'Params', Trim(AParams));
    WriteInteger(AButtonName, 'Section', ASection);

    MaxCount := ReadInteger('TotalButtons', 'MaxCount', 0) + 1;
    // 增加索引数字
    WriteInteger('TotalButtons', 'MaxCount', MaxCount);
    WriteString('TotalButtons', 'Item' + IntToStr(MaxCount), AButtonName);

    ButtonInfo := TButtonInfo.Create;
    with ButtonInfo do
    begin
      ButtonName := AButtonName;
      FileName := AFile;
      Params := AParams;
      Section := ASection;
      Button := skinButtonsBar.Sections[ASection].Items.Add;
      Button.OnClick := OnUserButtonClick;
      Button.Text := ButtonName;
      Button.ImageIndex := AddImageToImageList(FileName);
      FUserButtonsList.AddObject(ButtonName, ButtonInfo);
    end;
    Result := True;
  end;
end;

procedure TfmMain.ModifyButton(const AButtonName, AFile, AParams: string; const ASection: integer);
begin
  with FUserButtonsIniFile do
  begin
    WriteString(AButtonName, 'File', AFile);
    WriteString(AButtonName, 'Params', AParams);
    WriteInteger(AButtonName, 'Section', ASection);
  end;
end;

procedure TfmMain.DeleteToolButton(const Index: Integer; const AButtonName: string);
var
  I, MaxCount: Integer;
begin
  TButtonInfo(FUserButtonsList.Objects[Index]).Button.Free;
  FUserButtonsList.Delete(Index);
  with FUserButtonsIniFile do
  begin
    EraseSection(AButtonName);
    DeleteKey('TotalButtons', 'Item' + IntToStr(Index + 1));
    MaxCount := FUserButtonsList.Count;
    for I := 0 to MaxCount - 1 do
      with TButtonInfo(FUserButtonsList.Objects[i]) do
        WriteString('TotalButtons', 'Item' + IntToStr(I + 1), ButtonName);
    WriteInteger('TotalButtons', 'MaxCount', MaxCount);
  end;
end;

function TfmMain.AddImageToImageList(const AFile: string): Integer;
var
  HIcn: HICON;
  tmp: Word;
  tmpIcon: TIcon;
begin
  Result := 0;
  HIcn := ExtractAssociatedIcon(hInstance, PChar(AFile), tmp);
  if HIcn > 0 then
  begin
    tmpIcon := TIcon.Create;
    try
      tmpIcon.Handle := HIcn;
      Result := ilButtons.AddIcon(tmpIcon);
    finally
      tmpIcon.Free;
    end;
  end;
end;
//删除面板
//这个方法效率不高,但我没想到别的方法

procedure TfmMain.DeleteUserPanel(const aPanelName: string; const aSection: integer);
var
  I: integer;
  tempstrlist: Tstringlist;
  ButtonInfo: TButtonInfo;
begin
  tempstrlist := tstringlist.Create;
  FUserButtonsIniFile.DeleteKey('UserPanel',
    'Name' + inttostr(fmAddButton.lbPanel.Items.Count + 1));
  FPanelCount := FPanelCount - 1;
  FUserButtonsIniFile.WriteInteger('UserPanel', 'Count', FPanelCount);
  if fmAddButton.lbPanel.Items.Count > 0 then
    for I := 1 to fmAddButton.lbPanel.Items.Count do
    begin
      FUserButtonsIniFile.WriteString('UserPanel', 'Name' + inttostr(I), fmAddButton.lbPanel.Items[I - 1]);
      if I >= aSection then
        skinButtonsBar.Sections[I + 2].Text := fmAddButton.lbPanel.Items[I - 1];
    end;
  if FUserButtonsList.Count > 0 then //找出需要改动的按钮
    for I := 0 to FUserButtonsList.Count - 1 do
      if TButtonInfo(FUserButtonsList.Objects[I]).Section > aSection + 2 then
      begin
        ButtonInfo := TButtonInfo.Create;
        ButtonInfo.ButtonName := TButtonInfo(FUserButtonsList.Objects[I]).ButtonName;
        ButtonInfo.FileName := TButtonInfo(FUserButtonsList.Objects[I]).FileName;
        ButtonInfo.Params := TButtonInfo(FUserButtonsList.Objects[I]).Params;
        ButtonInfo.Section := TButtonInfo(FUserButtonsList.Objects[I]).Section;
        tempstrlist.AddObject(ButtonInfo.ButtonName, ButtonInfo);
      end;
      //修改按钮
  if tempstrlist.Count > 0 then
    for I := 0 to tempstrlist.Count - 1 do
      with TButtonInfo(tempstrlist.Objects[I]) do
      begin
        DeleteToolButton(FUserButtonsList.IndexOf(ButtonName), ButtonName);
        AddToolButton(ButtonName, FileName, Params, Section - 1);
      end;
  for I := 0 to tempstrlist.Count - 1 do
    tempstrlist.Objects[I].Free;
  tempstrlist.Free;

  ///////////////////////////////////////
  //少了这个IF就会出错,找这个错误好幸苦啊(花了好长时间,大量测试),因为有时删除正常,有时不正常
  //再加上我曾经又改过businessSkinForm
  if skinButtonsBar.SectionIndex = fmMain.skinButtonsBar.Sections.Count - 1 then
    skinButtonsBar.SectionIndex := skinButtonsBar.SectionIndex - 1;
  ///////////////////////////////////////

    // dec(skinButtonsBar.SectionIndex);为什么我想用这句话时出错?
  fmMain.skinButtonsBar.Sections[fmMain.skinButtonsBar.Sections.Count - 1].free;
end;
//增加面板

procedure TfmMain.AddUserPanel(const aPanelName: string);
begin
  FPanelCount := FPanelCount + 1;
  FUserButtonsIniFile.WriteInteger('UserPanel', 'Count', FPanelCount);
  FUserButtonsIniFile.WriteString('UserPanel', 'Name' + inttostr(FPanelCount), aPanelName);
  skinButtonsBar.Sections.Add;
  skinButtonsBar.Sections[FPanelCount + 2].Text := aPanelName;
  skinButtonsBar.Sections[FPanelCount + 2].OnClick := OnUserPanelClick;
end;
//修改面板名称

procedure TfmMain.ModifyUserPanel(const aPanelName: string; const aSection: integer);
begin
  FUserButtonsIniFile.WriteString('UserPanel', 'Name' + inttostr(aSection + 1), aPanelName);
  skinButtonsBar.Sections[aSection + 3].Text := aPanelName;
end;

procedure TfmMain.LoadUserPanel;
var
  I: integer;
begin
  FPanelCount := FUserButtonsIniFile.ReadInteger('UserPanel', 'Count', 0);
  if FPanelCount = 0 then
    exit
  else
    for I := 1 to FPanelCount do
    begin
      skinButtonsBar.Sections.Add;
      skinButtonsBar.Sections[I + 2].Text := FUserButtonsIniFile.ReadString('UserPanel', 'Name' + inttostr(I), '自定义' + inttostr(I));
      skinButtonsBar.Sections[I + 2].OnClick := OnUserPanelClick;
    end;
end;

procedure TfmMain.LoadUserButtons;
var
  I: Integer;
  MaxCount: Integer;
  ButtonInfo: TButtonInfo;
begin
  MaxCount := FUserButtonsIniFile.ReadInteger('TotalButtons', 'MaxCount', 0);
  if MaxCount <= 0 then Exit;
  for I := 1 to MaxCount do
  begin
    ButtonInfo := TButtonInfo.Create;
    with ButtonInfo do
    begin
      ButtonName := FUserButtonsIniFile.ReadString('TotalButtons',
        'Item' + IntToStr(I), '');
      if ButtonName = '' then
      begin
        Free;
        Continue;
      end;
      FileName := FUserButtonsIniFile.ReadString(ButtonName, 'File', '');
      if FileName = '' then
      begin
        Free;
        Continue;
      end;
      Params := FUserButtonsIniFile.ReadString(ButtonName, 'Params', '');
      Section := FUserButtonsIniFile.ReadInteger(ButtonName, 'Section', 2);

      if Section > skinButtonsBar.Sections.Count - 1 then
        section := 2;
      Button := skinButtonsBar.Sections[Section].Items.Add;
      Button.OnClick := OnUserButtonClick;
      Button.Text := ButtonName;
      Button.ImageIndex := AddImageToImageList(FileName);
      FUserButtonsList.AddObject(ButtonName, ButtonInfo);
    end; { end of with }
  end;
end;

procedure TfmMain.bsSkinButtonsBar1Sections0Items0Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowSendEmailDialog;
end;

procedure TfmMain.bsSkinButtonsBar1Sections0Items1Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowMessageBoxDialog;
end;

procedure TfmMain.bsSkinButtonsBar1Sections0Items2Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowKeyValueDialog;
end;

procedure TfmMain.bsSkinButtonsBar1Sections0Items3Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowAsciiDialog;
end;

procedure TfmMain.bsSkinButtonsBar1Sections0Items4Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowCommentDialog;
end;

procedure TfmMain.skinButtonsBarSections2Items0Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowCalc;
end;

procedure TfmMain.skinButtonsBarSections1Items0Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowFunctionDialog;
end;

procedure TfmMain.skinButtonsBarSections2Items1Click(Sender: TObject);
begin

  PlayButtonBarButtonClickSound;
  ShowAccessDialog;
end;

procedure TfmMain.tmHideTimer(Sender: TObject);
begin
  FIsMoveing := true;
  if FCanHide then
  begin
    fmMain.Left := fmMain.Left + 5;
    if screen.Width - fmMain.Left < 3 then
    begin
      fmMain.Left := screen.Width - 3;
      tmHide.Enabled := false;
      FCanHide := false;
      FIsMoveing := false;
    end;
  end
  else
  begin
    fmMain.Left := fmMain.Left - 10;
    if fmMain.Width + fmMain.Left < screen.Width then
    begin
      tmHide.Enabled := false;
      FCanHide := true;
      FIsMoveing := false;
      Ftop := fmMain.Top;
      Fleft := fmMain.Left;
      tmtime.Enabled := true;
    end;
  end;
end;

procedure TfmMain.skinButtonsBarMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
const
  ShiftState: array[0..6] of TShiftState = ([], [ssShift], [ssAlt], [ssCtrl], [ssLeft], [ssRight],
    [ssMiddle]);
begin
  if ((FMode < 7) and (Shift = ShiftState[FMode])) or ((FMode = 7) and (Shift <> [])) then
    if (not FCanHide) and (not FIsMoveing) then
      tmHide.Enabled := true;
end;

procedure TfmMain.tmtimeTimer(Sender: TObject);
begin
  inc(FHidetimen);
  //fmMain.Height=25时窗体是卷起状态
  if IsMouseInForm or (fmMain.Height = 25) then
    FHidetimen := 0;
  if (Ftop <> fmMain.Top) or (Fleft <> fmMain.Left) then
  begin
    FHidetimen := 0;
    tmtime.Enabled := false;
  end;
  if FHidetimen = 3 then
    HideForm;
end;

procedure TfmMain.SectionsSoundClick(Sender: TObject);
begin
///    pnlAddButtons.Visible := skinButtonsBar.SectionIndex = 2;
  if FPlaySound then
    PlaySound('SCLICK', hInstance, SND_ASYNC or SND_RESOURCE
      or SND_NODEFAULT);
end;

procedure TfmMain.btnAddClick(Sender: TObject);
var
  I: integer;
begin
  if FPlaySound then
    PlayDefButtonClickSound;
  fmAddButton.Visible := True;
  fmAddButton.BringToFront;
  fmAddButton.cbSection.Items.Clear;
  fmAddButton.lbPanel.Items.Clear;
  for I := 0 to skinButtonsBar.Sections.Count - 1 do
  begin
    fmAddButton.cbSection.Items.Add(skinButtonsBar.Sections[I].Text);
    if I > 2 then
      fmAddButton.lbPanel.Items.Add(skinButtonsBar.Sections[I].Text);
  end;
  fmAddButton.cbSection.ItemIndex := skinButtonsBar.SectionIndex;
end;

procedure TfmMain.btnModifyClick(Sender: TObject);
var
  I: integer;
begin
  if FPlaySound then
    PlayDefButtonClickSound;
  fmModifyButton.Visible := True;
  fmModifyButton.BringToFront;
  fmModifyButton.cbSound.Checked := FPlaySound;
  fmModifyButton.gbMode.ItemIndex := FMode;
  fmModifyButton.cbEffect.Checked := FUserButtonsIniFile.ReadBool('Set', 'FormEffect', true);
  //改了一点,如果不这样就有个奇怪的BUG,fmModifyButton.lvButtons中面板显示不正常
  fmModifyButton.cbSection.Items.Clear;
  for I := 0 to skinButtonsBar.Sections.Count - 1 do
    fmModifyButton.cbSection.Items.Add(skinButtonsBar.Sections[I].Text);
  fmModifyButton.ShowData;
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
  if (fmMain.Height <> 500) and (fmMain.Height <> 25) then //此句话要加的500时程序加载,在25时卷起
    FUserButtonsIniFile.WriteInteger('Set', 'Height', fmMain.Height);
  FUserButtonsIniFile.WriteInteger('Set', 'Width', fmMain.Width);
  btnAdd.Width := round(pnlAddButtons.Width / 2);
  btnModify.Left := btnAdd.Width;
  btnModify.Width := btnAdd.Width;
end;

procedure TfmMain.skinButtonsBarSections1Items1Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowApiDialog;
end;

procedure TfmMain.skinButtonsBarSections1Items2Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowFunctionbaseDialog;
end;

procedure TfmMain.skinButtonsBarSections2Items2Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  if Assigned(PasFileEditForm) then
    PasFileEditForm.Show
  else
    ActiveWindow(PasFileEditForm.Handle);
end;

procedure TfmMain.WMMOUSEWHEEL(var Msg: TMessage);
begin
  if IsMouseInForm and (FCanHide) and (not FIsMoveing) then // and(skinButtonsBar.Focused)
    case msg.wparam of
      7864320:
        if skinButtonsBar.SectionIndex <> skinButtonsBar.Sections.Count then
          skinButtonsBar.SectionIndex := skinButtonsBar.SectionIndex + 1;
        //inc(skinButtonsBar.SectionIndex);
      -7864320:
        if skinButtonsBar.SectionIndex <> 0 then
          skinButtonsBar.SectionIndex := skinButtonsBar.SectionIndex - 1;
       // dec(skinButtonsBar.SectionIndex);
    end;
end;


procedure TfmMain.skinButtonsBarSections2Items3Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowResBuilderDialog;
end;

procedure TfmMain.AWTrayIcon1LeftClick(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (not FCanHide) and (not FIsMoveing) then
    tmHide.Enabled := true;
end;

procedure TfmMain.skinButtonsBarSections2Items4Click(Sender: TObject);
begin
  PlayButtonBarButtonClickSound;
  ShowHelpDialog;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -