ebarmegademomain.pas

胜天进销存源码,国产优秀的进销存

    end
    else
      if Sender.Text <> '' then begin
        Draw(Left + 1, Top + 2, Image.Picture.Bitmap);
        TextOut(RectText.Left + 2, Top , Sender.Text);
      end;
    if odSelected in AState then
      DrawFocusRect(RectText);
  end;
end;

procedure TEBarMegaDemoMainForm.FindAddress;
var Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  FHTML.Navigate(FAddress, Flags, TargetFrameName, PostData, Headers);
end;


procedure TEBarMegaDemoMainForm.dxStopBtnClick(Sender: TObject);
begin
  if FHistoryIndex <> -1 then FHTML.Stop;
end;

procedure TEBarMegaDemoMainForm.dxRefreshBtnClick(Sender: TObject);
begin
  if FHistoryIndex <> -1 then FHTML.Refresh;
end;

procedure TEBarMegaDemoMainForm.dxHomeBtnClick(Sender: TObject);
begin
 FAddress := 'http://www.devexpress.com/';
 FindAddress;
end;

procedure TEBarMegaDemoMainForm.dxProductsBtnClick(Sender: TObject);
begin
 FAddress := TdxBarLargeButton(Sender).Hint;
 FindAddress;
end;

procedure TEBarMegaDemoMainForm.dxAddressComboChange(Sender: TObject);
begin
  if FUpdateCombo then
  begin
    FAddress := dxAddressCombo.Text;
    FindAddress;
  end;
end;

procedure TEBarMegaDemoMainForm.FormDestroy(Sender: TObject);
begin
  FHTML.Stop;
  FHistoryList.Free;
  FHTML.Free;
end;

procedure TEBarMegaDemoMainForm.dxBackBtnClick(Sender: TObject);
begin
  FAddress := FHistoryList[FHistoryIndex - 1];
  FindAddress;
end;

procedure TEBarMegaDemoMainForm.dxForwardBtnClick(Sender: TObject);
begin
  FAddress := FHistoryList[FHistoryIndex + 1];
  FindAddress;
end;

procedure TEBarMegaDemoMainForm.dxBarHistoryClick(Sender: TObject);
begin
  if TdxBarLargeButton(Sender).ClickItemLink <> nil then
  begin
    FAddress := TdxBarLargeButton(Sender).ClickItemLink.UserCaption;
    FindAddress;
  end;
end;

procedure TEBarMegaDemoMainForm.dxSearchBtnClick(Sender: TObject);
begin
  FHTML.GoSearch;
end;

procedure TEBarMegaDemoMainForm.dxCityComboChange(Sender: TObject);
begin
  SetFilter;
end;

procedure TEBarMegaDemoMainForm.SetFilter;
const
  PaymentStr: array [0..3] of string = ('CASH', 'VISA', 'MASTER', 'AMEX');
var
  Filter: string;
  I: integer;
begin
  Filter := '';

  with dxCityCombo do
    if Text <> '' then
      if SelectedNode.Count = 0 then
        Filter := 'City = ''' + Text + ''''
      else
      begin
        for I := 0 to SelectedNode.Count - 1 do
          if Filter = '' then
            Filter := Filter + '( City = ''' + SelectedNode.Item[I].Text + ''' )'
          else
            Filter := Filter + ' or ( City = ''' + SelectedNode.Item[I].Text + ''' )';
      end;
    if Filter <> '' then
      Filter := '(' + Filter + ')';
    if dxProductsCombo.Text <> '' then
      if Filter = '' then
        Filter := '( ProductID = ' + EBarMegaDemoMainDM.tblProducts.FieldByName('ID').AsString + ')'
      else Filter := Filter + ' and ( ProductID = ' + EBarMegaDemoMainDM.tblProducts.FieldByName('ID').AsString + ')';
    if dxDate.Text <> '' then
      if Filter = '' then
        Filter := '( PurchaseDate = ''' + DateToStr(dxDate.Date) + ''')'
      else
        Filter := Filter + ' and ( PurchaseDate = ''' + DateToStr(dxDate.Date) + ''')';
    if dxTypeCombo.Text <> '' then
      if Filter = '' then
        Filter := '( PaymentType = ''' + PaymentStr[dxTypeCombo.ItemIndex] + ''')'
      else
        Filter := Filter + ' and ( PaymentType = ''' + PaymentStr[dxTypeCombo.ItemIndex] + ''')';
  EBarMegaDemoMainDM.tblContacts.Filter := Filter;
  EBarMegaDemoMainDM.tblContacts.Filtered := True;
end;

procedure TEBarMegaDemoMainForm.dxClearBtnClick(Sender: TObject);
begin
  dxCityCombo.Text := '';
  dxProductsCombo.KeyValue := null;
  dxProductsCombo.Text := '';
  dxDate.Text := '';
  dxTypeCombo.ItemIndex := -1;
  EBarMegaDemoMainDM.tblContacts.Filter := '';
  EBarMegaDemoMainDM.tblContacts.Filtered := False;
end;

procedure TEBarMegaDemoMainForm.dxProductsComboChange(Sender: TObject);
begin
  SetFilter;
end;

procedure TEBarMegaDemoMainForm.dxDateChange(Sender: TObject);
begin
  SetFilter;
end;

procedure TEBarMegaDemoMainForm.dxOptionsClick(Sender: TObject);
begin
  EBarMegaDemoOptionsForm.Show;
end;

procedure TEBarMegaDemoMainForm.dxTypeComboChange(Sender: TObject);
begin
  SetFilter;
end;

procedure TEBarMegaDemoMainForm.ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
  dxBarProgress.Max := ProgressMax;
  dxBarProgress.Position := Progress;
end;

procedure TEBarMegaDemoMainForm.DocumentComplete(Sender: TObject; pDisp: IDispatch; var URL: OleVariant);
begin
  dxBarProgress.Position := 0;
end;

procedure TEBarMegaDemoMainForm.FindDialogFind(Sender: TObject);
var
  StartPos, FindLength, FoundAt: Integer;
  Flags: TSearchTypes;
  P: TPoint;
  CaretR, R, IntersectR: TRect;
begin
  with Editor, TFindDialog(Sender) do
  begin
    if frDown in Options then
    begin
      if SelLength = 0 then StartPos := SelStart
      else StartPos := SelStart + SelLength;
      FindLength := Length(Text) - StartPos;
    end
    else
    begin
      StartPos := SelStart;
      FindLength := -StartPos;
    end;
    Flags := [];
    if frMatchCase in Options then Include(Flags, stMatchCase);
    if frWholeWord in Options then Include(Flags, stWholeWord);
    Screen.Cursor := crHourglass;
    FoundAt := Editor.FindText(FindText, StartPos, FindLength, Flags);
    if not (frReplaceAll in Options) then Screen.Cursor := crDefault;
    if FoundAt > -1 then
      if frReplaceAll in Options then
      begin
        SelStart := FoundAt;
        SelLength := Length(FindText);
      end
      else
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(FindText);

        GetCaretPos(P);
        P := ClientToScreen(P);
        CaretR := Rect(P.X, P.Y, P.X + 2, P.Y + 20);
        GetWindowRect(Handle, R);
        if IntersectRect(IntersectR, CaretR, R) then
          if P.Y < Screen.Height div 2 then
            Top := P.Y + 40
          else
            Top := P.Y - (R.Bottom - R.Top + 20);
      end
    else
      if not (frReplaceAll in Options) then
        Application.MessageBox('Text not found', 'Information', MB_ICONINFORMATION);
  end;
end;

procedure TEBarMegaDemoMainForm.ReplaceDialogReplace(Sender: TObject);
var
  ReplacedCount, OldSelStart, PrevSelStart: Integer;
  S: string;
begin
  with Editor, TReplaceDialog(Sender) do
  begin
    ReplacedCount := 0;
    OldSelStart := SelStart;
    if frReplaceAll in Options then
      Screen.Cursor := crHourglass;
    repeat
      if (SelLength > 0) and ((SelText = FindText) or
        (not (frMatchCase in Options) and
         (AnsiUpperCase(SelText) = AnsiUpperCase(FindText)))) then
      begin
        SelText := ReplaceText;
        Inc(ReplacedCount);
      end;
      PrevSelStart := SelStart;
      FindDialogFind(Sender);
    until not (frReplaceAll in Options) or (SelStart = PrevSelStart);
    if frReplaceAll in Options then
    begin
      Screen.Cursor := crDefault;
      if ReplacedCount = 0 then S := 'Text not found'
      else
      begin
        SelStart := OldSelStart;
        S := Format('Replace All', [ReplacedCount]);
      end;
      Application.MessageBox(PChar(S), 'Information',
        MB_ICONINFORMATION);
    end;
  end;
end;

procedure TEBarMegaDemoMainForm.BeforeNavigate(Sender: TObject; pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
var
  NewIndex, I: Integer;
  NAddress: string;
begin

  NAddress := URL;
  if NAddress = '' then NAddress := FAddress;
  if NAddress = '' then exit;

  NewIndex := FHistoryList.IndexOf(NAddress);
  if NewIndex = -1 then
  begin
    FHistoryList.Add(NAddress);
    NewIndex := FHistoryList.IndexOf(NAddress);
  end;

  FUpdateCombo := False;
  dxAddressCombo.Text := NAddress;
  FUpdateCombo := True;


  with ForwardPopupMenu.ItemLinks do
  begin
   Clear;
   for I := FHistoryList.Count - 1 downto NewIndex + 1 do
    with Add do
     begin
      Index := 0;
      Item := dxBarHistory;
      UserCaption := FHistoryList[i];
     end;
  end;

  with BackPopupMenu.ItemLinks do
  begin
   Clear;
   for i := 0 to NewIndex - 1 do
    with Add do
     begin
      Index := 0;
      Item := dxBarHistory;
      UserCaption := FHistoryList[I];
     end;
  end;

  FHistoryIndex := NewIndex;

  if FHistoryIndex = 0 then
  begin
    dxBackBtn.Enabled := False;
    dxIEBackBtn.Enabled := False;
  end else
  begin
    dxBackBtn.Enabled := True;
    dxIEBackBtn.Enabled := True;
  end;

  if FHistoryIndex = FHistoryList.Count - 1 then
  begin
    dxForwardBtn.Enabled := False;
    dxIEForwardBtn.Enabled := False;
  end else
  begin
    dxForwardBtn.Enabled := True;
    dxIEForwardBtn.Enabled := True;
  end;
end;

procedure TEBarMegaDemoMainForm.StatusTextChange(Sender: TObject; const Text: WideString);
begin
  if Text = '' then
    dxBSIEStatus.Caption := 'Done'
  else
    dxBSIEStatus.Caption := TCaption(Text);
end;

procedure TEBarMegaDemoMainForm.TitleChange(Sender: TObject; const Text: WideString);
begin
  Caption := TCaption(Text);
end;

end.